home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
- Object = "{26128CCE-6170-11D7-B22B-BCE241A42133}#11.1#0"; "caImagX.ocx"
- Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
- Begin VB.Form frmTest
- Caption = "TEST"
- ClientHeight = 6510
- ClientLeft = 150
- ClientTop = 720
- ClientWidth = 9480
- BeginProperty Font
- Name = "Verdana"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Icon = "frmTest.frx":0000
- LinkTopic = "Form1"
- LockControls = -1 'True
- MaxButton = 0 'False
- ScaleHeight = 6510
- ScaleWidth = 9480
- Begin MSComctlLib.Slider sldBright
- Height = 345
- Left = 7950
- TabIndex = 21
- Top = 4830
- Width = 1560
- _ExtentX = 2752
- _ExtentY = 609
- _Version = 393216
- Max = 100
- TickStyle = 3
- End
- Begin VB.PictureBox piColor
- Appearance = 0 'Flat
- BackColor = &H00000000&
- ForeColor = &H80000008&
- Height = 300
- Index = 2
- Left = 7740
- ScaleHeight = 270
- ScaleWidth = 270
- TabIndex = 19
- Top = 840
- Width = 300
- End
- Begin VB.PictureBox piColor
- Appearance = 0 'Flat
- BackColor = &H00FFFFFF&
- ForeColor = &H80000008&
- Height = 300
- Index = 1
- Left = 9060
- ScaleHeight = 270
- ScaleWidth = 270
- TabIndex = 18
- Top = 480
- Width = 300
- End
- Begin VB.PictureBox piColor
- Appearance = 0 'Flat
- BackColor = &H00000000&
- ForeColor = &H80000008&
- Height = 300
- Index = 0
- Left = 7740
- ScaleHeight = 270
- ScaleWidth = 270
- TabIndex = 17
- Top = 480
- Width = 300
- End
- Begin VB.PictureBox piPal
- Appearance = 0 'Flat
- AutoRedraw = -1 'True
- ForeColor = &H80000008&
- Height = 2430
- Left = 6960
- ScaleHeight = 2400
- ScaleWidth = 2400
- TabIndex = 16
- Top = 1710
- Width = 2430
- End
- Begin VB.PictureBox pi0
- BackColor = &H8000000C&
- Height = 5760
- Left = 60
- ScaleHeight = 5700
- ScaleWidth = 6750
- TabIndex = 12
- Top = 420
- Width = 6810
- Begin VB.PictureBox pi00
- BorderStyle = 0 'None
- Height = 300
- Left = 6495
- ScaleHeight = 300
- ScaleWidth = 300
- TabIndex = 20
- Top = 5445
- Width = 300
- End
- Begin VB.Timer tmrUndo
- Enabled = 0 'False
- Interval = 100
- Left = 90
- Top = 870
- End
- Begin VB.VScrollBar vscr0
- Height = 5445
- Left = 6510
- Max = 7
- Min = 1
- TabIndex = 14
- Top = 0
- Value = 4
- Width = 240
- End
- Begin VB.HScrollBar hscr0
- Height = 240
- Left = 0
- Max = 7
- Min = 1
- TabIndex = 13
- Top = 5460
- Value = 4
- Width = 6495
- End
- Begin caImagXP.imaG piX
- Height = 900
- Left = 360
- TabIndex = 15
- Top = 210
- Visible = 0 'False
- Width = 900
- _ExtentX = 1588
- _ExtentY = 1588
- BackColor = -2147483636
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "Verdana"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Picture = "frmTest.frx":0442
- End
- End
- Begin MSComDlg.CommonDialog CD
- Left = 8580
- Top = 870
- _ExtentX = 847
- _ExtentY = 847
- _Version = 393216
- CancelError = -1 'True
- Filter = "Bmp file |*.bmp|Gif file|*.gif|Jpg file|*.jpg|Tif file|*.tif"
- End
- Begin MSComctlLib.ImageList IL
- Left = 8370
- Top = 960
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 16
- ImageHeight = 16
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 14
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":0498
- Key = "open"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":05F4
- Key = "save"
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":0B90
- Key = "capture"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":112C
- Key = "erase"
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":16C8
- Key = "fill"
- EndProperty
- BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":1C64
- Key = "line"
- EndProperty
- BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":2200
- Key = "pen"
- EndProperty
- BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":279C
- Key = "select"
- EndProperty
- BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":2D38
- Key = "rectangle"
- EndProperty
- BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":32D4
- Key = "ellipse"
- EndProperty
- BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":3870
- Key = "undo"
- EndProperty
- BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":3E0C
- Key = "redo"
- EndProperty
- BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":43A8
- Key = "arrow"
- EndProperty
- BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "frmTest.frx":4944
- Key = "color"
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.StatusBar stb0
- Align = 2 'Align Bottom
- Height = 240
- Left = 0
- TabIndex = 10
- Top = 6270
- Width = 9480
- _ExtentX = 16722
- _ExtentY = 423
- _Version = 393216
- BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
- NumPanels = 5
- BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
- Object.Width = 2646
- MinWidth = 2646
- EndProperty
- BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
- Object.Width = 3616
- MinWidth = 3616
- EndProperty
- BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
- Object.Width = 2822
- MinWidth = 2822
- EndProperty
- BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
- Object.Width = 3528
- MinWidth = 3528
- EndProperty
- BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628}
- AutoSize = 1
- Object.Width = 3493
- EndProperty
- EndProperty
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "Verdana"
- Size = 7.5
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- End
- Begin MSComctlLib.Toolbar tlb0
- Align = 1 'Align Top
- Height = 360
- Left = 0
- TabIndex = 9
- Top = 0
- Width = 9480
- _ExtentX = 16722
- _ExtentY = 635
- ButtonWidth = 609
- ButtonHeight = 582
- Appearance = 1
- Style = 1
- ImageList = "IL"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 19
- BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "open"
- Object.ToolTipText = "Open"
- EndProperty
- BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "save"
- Object.ToolTipText = "Save"
- EndProperty
- BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "sep0"
- Style = 3
- EndProperty
- BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "undo"
- Object.ToolTipText = "Undo"
- EndProperty
- BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "redo"
- Object.ToolTipText = "Redo"
- EndProperty
- BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "sep1"
- Style = 3
- EndProperty
- BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "draw"
- Object.ToolTipText = "Draw Mode"
- Style = 1
- Value = 1
- EndProperty
- BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "sep2"
- Style = 3
- EndProperty
- BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "select"
- Object.ToolTipText = "Select"
- Style = 1
- EndProperty
- BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "pen"
- Object.ToolTipText = "Pen"
- Style = 1
- EndProperty
- BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "line"
- Object.ToolTipText = "Line"
- Style = 1
- EndProperty
- BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "rectangle"
- Object.ToolTipText = "Rectangle"
- Style = 1
- EndProperty
- BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "ellipse"
- Object.ToolTipText = "Ellipse"
- Style = 1
- EndProperty
- BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "sep3"
- Style = 3
- EndProperty
- BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "fill"
- Object.ToolTipText = "Fill"
- Style = 1
- EndProperty
- BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "erase"
- Object.ToolTipText = "Erase"
- Style = 1
- EndProperty
- BeginProperty Button17 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "capture"
- Object.ToolTipText = "Capture"
- Style = 1
- EndProperty
- BeginProperty Button18 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button19 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Enabled = 0 'False
- Key = "palette"
- Object.ToolTipText = "View Palette"
- Object.Tag = "color"
- EndProperty
- EndProperty
- End
- Begin VB.ComboBox cbZoom
- Enabled = 0 'False
- Height = 315
- ItemData = "frmTest.frx":4AA0
- Left = 8010
- List = "frmTest.frx":4AB6
- Style = 2 'Dropdown List
- TabIndex = 0
- Top = 4290
- Width = 1425
- End
- Begin MSComctlLib.Slider sldContrast
- Height = 345
- Left = 7950
- TabIndex = 22
- Top = 5190
- Width = 1560
- _ExtentX = 2752
- _ExtentY = 609
- _Version = 393216
- Max = 100
- TickStyle = 3
- End
- Begin MSComctlLib.Slider sldGamma
- Height = 345
- Left = 6900
- TabIndex = 23
- Top = 5850
- Width = 2610
- _ExtentX = 4604
- _ExtentY = 609
- _Version = 393216
- Max = 1000
- TickStyle = 3
- End
- Begin VB.Label lb0
- Alignment = 1 'Right Justify
- Caption = "COLORS"
- Height = 210
- Index = 4
- Left = 8190
- TabIndex = 4
- Top = 960
- Width = 1200
- End
- Begin VB.Label lbZoom
- Caption = "Zoom"
- Enabled = 0 'False
- BeginProperty Font
- Name = "Verdana"
- Size = 7.5
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 210
- Left = 6990
- TabIndex = 7
- Top = 4350
- Width = 1095
- End
- Begin VB.Label lb0
- Caption = "Palette"
- Height = 210
- Index = 0
- Left = 6960
- TabIndex = 11
- Top = 1350
- Width = 1095
- End
- Begin VB.Label lb0
- Caption = "Fill"
- BeginProperty Font
- Name = "Verdana"
- Size = 7.5
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 210
- Index = 3
- Left = 7320
- TabIndex = 8
- Top = 870
- Width = 735
- End
- Begin VB.Label lb0
- Caption = "Right"
- BeginProperty Font
- Name = "Verdana"
- Size = 7.5
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 210
- Index = 2
- Left = 8550
- TabIndex = 6
- Top = 510
- Width = 705
- End
- Begin VB.Label lb0
- Caption = "Left"
- BeginProperty Font
- Name = "Verdana"
- Size = 7.5
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 210
- Index = 1
- Left = 7320
- TabIndex = 5
- Top = 510
- Width = 735
- End
- Begin VB.Label lbGamma
- Caption = "Gamma ..."
- Enabled = 0 'False
- BeginProperty Font
- Name = "Verdana"
- Size = 7.5
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 225
- Left = 6990
- TabIndex = 3
- Top = 5640
- Width = 1275
- End
- Begin VB.Label lbContrast
- Caption = "Contrast ..."
- Enabled = 0 'False
- BeginProperty Font
- Name = "Verdana"
- Size = 7.5
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 225
- Left = 6990
- TabIndex = 2
- Top = 5250
- Width = 825
- End
- Begin VB.Label lbBright
- Caption = "Brightness ..."
- Enabled = 0 'False
- BeginProperty Font
- Name = "Verdana"
- Size = 7.5
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 225
- Left = 6990
- TabIndex = 1
- Top = 4890
- Width = 945
- End
- Begin VB.Menu mnFile
- Caption = "File"
- Begin VB.Menu mnFile24
- Caption = "Load 24"
- End
- Begin VB.Menu mnFile256
- Caption = "Load 256"
- End
- Begin VB.Menu mnFileGif
- Caption = "Load Gif"
- End
- Begin VB.Menu mnFileJpg
- Caption = "LoadJ pg"
- End
- Begin VB.Menu mnFileSep0
- Caption = "-"
- End
- Begin VB.Menu mnFileOpen
- Caption = "Open"
- End
- Begin VB.Menu mnFileSave
- Caption = "Save"
- Enabled = 0 'False
- End
- End
- Begin VB.Menu mnEdit
- Caption = "Edit"
- Enabled = 0 'False
- Begin VB.Menu mnEditCut
- Caption = "Cut"
- End
- Begin VB.Menu mnEditCopy
- Caption = "Copy"
- End
- Begin VB.Menu mnEditPaste
- Caption = "Paste"
- End
- Begin VB.Menu mnEditSep0
- Caption = "-"
- End
- Begin VB.Menu mnEditUndo
- Caption = "Undo"
- End
- Begin VB.Menu mnEditRedo
- Caption = "Redo"
- End
- Begin VB.Menu mnEditSep1
- Caption = "-"
- End
- Begin VB.Menu mnEditDrawMode
- Caption = "Draw Mode"
- Begin VB.Menu mnEditDrawMode0
- Caption = ""
- Index = 0
- End
- End
- Begin VB.Menu mnEditEditMode
- Caption = "Edit Mode"
- Begin VB.Menu mnEditEditMode0
- Caption = ""
- Index = 0
- End
- End
- Begin VB.Menu mnEditSep2
- Caption = "-"
- End
- Begin VB.Menu mnEditEffects
- Caption = "Effects"
- End
- End
- Begin VB.Menu mnImage
- Caption = "Image"
- Enabled = 0 'False
- Begin VB.Menu mnImageMirror
- Caption = "Mirror"
- End
- Begin VB.Menu mnImageFlip
- Caption = "Flip"
- End
- Begin VB.Menu mnImageRotate0
- Caption = "Rotate 90"
- End
- Begin VB.Menu mnImageRotate1
- Caption = "Rotate 270"
- End
- Begin VB.Menu mnImageRotate2
- Caption = "Rotate 180"
- End
- End
- Begin VB.Menu mnColor
- Caption = "Color"
- Enabled = 0 'False
- Begin VB.Menu mnColorGray
- Caption = "GrayScale"
- End
- Begin VB.Menu mnColorSep0
- Caption = "-"
- End
- Begin VB.Menu mnColorCd24
- Caption = "Color Depth 24"
- End
- Begin VB.Menu mnColorCd8
- Caption = "Color Depth 8"
- End
- Begin VB.Menu mnColorCd4
- Caption = "Color Depth 4"
- End
- Begin VB.Menu mnColorCd1
- Caption = "Color Depth 1"
- End
- Begin VB.Menu mnColorSep1
- Caption = "-"
- End
- Begin VB.Menu mnColorLoadP
- Caption = "Load Palette"
- End
- End
- Attribute VB_Name = "frmTest"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Option Explicit
- Private TestPath As String
- Private ButtonPressed As Integer
- Sub OpenDone()
- Dim n As Integer
- mnFileSave.Enabled = True
- mnEdit.Enabled = True
- mnImage.Enabled = True
- mnColor.Enabled = True
- For n = 1 To tlb0.Buttons.Count
- tlb0.Buttons(n).Enabled = True
- Next
- lbZoom.Enabled = True
- cbZoom.Enabled = True
- sldBright.Enabled = True
- sldContrast.Enabled = True
- sldGamma.Enabled = True
- lbBright.Enabled = True
- lbContrast.Enabled = True
- lbGamma.Enabled = True
- piX.Move (pi0.ScaleWidth - piX.Width) / 2, (pi0.ScaleHeight - piX.Height) / 2
- DoEvents ' show image
- ViewImageData
- piX.Visible = True
- tmrUndo.Enabled = True
- End Sub
- Sub ResetSliders()
- sldBright.Value = 50
- sldContrast.Value = 50
- sldGamma.Value = 500
- vscr0.Value = 4
- hscr0.Value = 4
- End Sub
- Sub SelectModeButton(Key As String)
- Dim n As Integer
- For n = 0 To mnEditEditMode0.ubound
- If mnEditEditMode0(n).Tag = Key Then
- mnEditEditMode0_Click (n)
- End If
- Next
- If Key = "draw" Then mnEditDrawMode0_Click (-1)
- End Sub
- Sub Settings()
- Dim n As Integer
- ' MENU
- For n = 1 To 3
- Load mnEditDrawMode0(mnEditDrawMode0.ubound + 1)
- Next
- mnEditDrawMode0(0).Caption = "Draw Line"
- mnEditDrawMode0(0).Tag = "draw"
- mnEditDrawMode0(1).Caption = "Draw Rectangle"
- mnEditDrawMode0(1).Tag = "draw"
- mnEditDrawMode0(2).Caption = "Draw Circle"
- mnEditDrawMode0(2).Tag = "draw"
- mnEditDrawMode0(3).Caption = "Draw String"
- mnEditDrawMode0(3).Tag = "draw"
- mnEditDrawMode.Tag = "draw"
- For n = 1 To 11
- Load mnEditEditMode0(mnEditEditMode0.ubound + 1)
- Next
-
- mnEditEditMode0(0).Caption = "Select"
- mnEditEditMode0(0).Tag = "select"
- mnEditEditMode0(1).Caption = "Pen"
- mnEditEditMode0(1).Tag = "pen"
- mnEditEditMode0(2).Caption = "Brush"
- mnEditEditMode0(2).Tag = "brush"
- mnEditEditMode0(3).Caption = "Line"
- mnEditEditMode0(3).Tag = "line"
- mnEditEditMode0(4).Caption = "Rectangle"
- mnEditEditMode0(4).Tag = "rectangle"
- mnEditEditMode0(5).Caption = "Round Rectangle"
- mnEditEditMode0(5).Tag = "roundrectangle"
- mnEditEditMode0(6).Caption = "Filled Rectangle"
- mnEditEditMode0(6).Tag = "filledrectangle"
- mnEditEditMode0(7).Caption = "Ellipse"
- mnEditEditMode0(7).Tag = "ellipse"
- mnEditEditMode0(8).Caption = "Filled Ellipse"
- mnEditEditMode0(8).Tag = "filledellipse"
- mnEditEditMode0(9).Caption = "Capture"
- mnEditEditMode0(9).Tag = "capture"
- mnEditEditMode0(10).Caption = "Erase"
- mnEditEditMode0(10).Tag = "erase"
- mnEditEditMode0(11).Caption = "Fill"
- mnEditEditMode0(11).Tag = "fill"
- ' TOOLBAR
- tlb0.Buttons("open").Image = IL.ListImages.Item("open").Index
- tlb0.Buttons("save").Image = IL.ListImages.Item("save").Index
- tlb0.Buttons("undo").Image = IL.ListImages.Item("undo").Index
- tlb0.Buttons("redo").Image = IL.ListImages.Item("redo").Index
- tlb0.Buttons("draw").Image = IL.ListImages.Item("arrow").Index
- tlb0.Buttons("select").Image = IL.ListImages.Item("select").Index
- tlb0.Buttons("pen").Image = IL.ListImages.Item("pen").Index
- tlb0.Buttons("line").Image = IL.ListImages.Item("line").Index
- tlb0.Buttons("rectangle").Image = IL.ListImages.Item("rectangle").Index
- tlb0.Buttons("ellipse").Image = IL.ListImages.Item("ellipse").Index
- tlb0.Buttons("fill").Image = IL.ListImages.Item("fill").Index
- tlb0.Buttons("erase").Image = IL.ListImages.Item("erase").Index
- tlb0.Buttons("capture").Image = IL.ListImages.Item("capture").Index
- tlb0.Buttons("palette").Image = IL.ListImages.Item("color").Index
- End Sub
- Sub QueryEnabled()
- Dim DrawEnabled As Boolean, EditEnabled As Boolean, SelectAEnabled As Boolean, CutPaste As Boolean
- piX.QueryAction DrawEnabled, EditEnabled, SelectAEnabled, CutPaste
- mnEditCut.Enabled = CutPaste
- mnEditPaste.Enabled = CutPaste
- mnEditEffects.Enabled = DrawEnabled
- sldBright.Enabled = DrawEnabled
- sldContrast.Enabled = DrawEnabled
- sldGamma.Enabled = DrawEnabled
- lbBright.Enabled = DrawEnabled
- lbContrast.Enabled = DrawEnabled
- lbGamma.Enabled = DrawEnabled
- mnColor.Enabled = DrawEnabled
- mnFile.Enabled = DrawEnabled
- mnImage.Enabled = DrawEnabled
- End Sub
- Private Sub SetSelection(SelMode As String)
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- Select Case SelMode
- Case "select"
- piX.Mode = caModeEditSelection
- Case "pen"
- piX.Mode = caModeEditPen
- Case "brush"
- piX.EditLineWidth(caBrushWidth) = 4
- piX.Mode = caModeEditBrush
- Case "capture"
- piX.Mode = caModeEditCapture
- Case "erase"
- piX.EditLineWidth(caEraserWidth) = 4
- piX.Mode = caModeEditEraser
- Case "line"
- piX.EditLineWidth(caLineWidth) = 1
- piX.Mode = caModeEditLine
- Case "fill"
- piX.Mode = caModeEditFill
- Case "rectangle"
- piX.EditLineWidth(caRectangleEllipseWidth) = 1
- piX.Mode = caModeEditRectangle
- Case "filledrectangle"
- piX.Mode = caModeEditRectangleFilled
- Case "ellipse"
- piX.EditLineWidth(caRectangleEllipseWidth) = 4
- piX.Mode = caModeEditEllipse
- Case "filledellipse"
- piX.Mode = caModeEditEllipseFilled
- Case "draw0" '"Line"
- piX.DrawLine 200, 200, 1000, 1000, &H0&, False
- Case "draw1" '"Rectangle"
- piX.DrawLine 200, 200, 1000, 1000, , True
- Case "draw2" '"Circle"
- piX.DrawCircle 500, 500, 1000, &HFF&
- Case "draw3" '"String"
- Dim Fnt As New StdFont
- Fnt.Name = "Verdana"
- Fnt.Size = 14
- piX.DrawString "This is a new string", 200, 200, &HFFFFFF, Fnt
- End Select
- QueryEnabled
- End Sub
- Private Sub cbZoom_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- Select Case cbZoom.ListIndex
- Case 0: piX.Zoom = 0.25
- Case 1: piX.Zoom = 0.5
- Case 2: piX.Zoom = 1
- Case 3: piX.Zoom = 2
- Case 4: piX.Zoom = 3
- Case 5: piX.Zoom = 4
- End Select
- vscr0.Value = 3: hscr0.Value = 3
- vscr0.Value = 4: hscr0.Value = 4
- End Sub
- Private Sub ViewImageData()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- Dim pal() As Long, i As Long, ii As Long, cnt As Long
- Const DD = 150
- piPal.Cls
- If piX.GetPalette(pal) Then
- For ii = 0 To 15
- For i = 0 To 15
- If cnt <= UBound(pal) Then
- piPal.Line (i * DD, ii * DD)-((i * DD) + DD, (ii * DD) + DD), pal(cnt), BF
- End If
- cnt = cnt + 1
- Next
- Next
- End If
- If piX.ColorDepth = caRGB Then
- stb0.Panels(2).Text = "Color Mode: RGB"
- Else
- stb0.Panels(2).Text = "Color Mode: Palette"
- End If
- stb0.Panels(3).Text = "Color Depth: " & piX.ColorDepth
- stb0.Panels(4).Text = "Color Count: " & Format(piX.ColorCount, "#,##0")
- stb0.Panels(5).Text = "X: " & Format(piX.ImageResolutionX, "#,##0") & " - Y: " & Format(piX.ImageResolutionY, "#,##0")
- End Sub
- Private Sub Form_Load()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- TestPath = App.Path
- Settings
- stb0.Panels(1).Text = "Mode: Draw"
- Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2, 9600, 7200
- End Sub
- Private Sub hscr0_Change()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Left = ((pi0.ScaleWidth - piX.Width) / 2) - ((hscr0.Value - 4) * 1500)
- pi0.SetFocus
- End Sub
- Private Sub sldBright_Change()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- If sldBright <> 50 Then sldBright_Scroll
- End Sub
- Private Sub sldBright_LostFocus()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- ViewImageData
- End Sub
- Private Sub sldBright_Scroll()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Brightness sldBright
- DoEvents
- End Sub
- Private Sub sldContrast_Change()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- If sldContrast <> 50 Then sldContrast_Scroll
- End Sub
- Private Sub sldContrast_LostFocus()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- ViewImageData
- End Sub
- Private Sub sldContrast_Scroll()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Contrast sldContrast
- DoEvents
- End Sub
- Private Sub sldGamma_Change()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- If sldGamma <> 500 Then sldGamma_Scroll
- End Sub
- Private Sub sldGamma_LostFocus()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- ViewImageData
- End Sub
- Private Sub sldGamma_Scroll()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Gamma sldGamma
- DoEvents
- End Sub
- Function ErrS() As Boolean
- ErrS = False
- If Err.Number <> 0 Then
- MsgBox "Error with number: " & Format(Err.Number, "#,##0") & vbCr & vbCr & Err.Description, vbCritical, "ERROR"
- ErrS = True
- Err.Clear
- End If
- End Function
- Private Sub mnColorLoadP_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- Dim vPal(255) As Long, n As Integer
- piX.Undo_Add "change palette"
- For n = 0 To 255
- vPal(n) = n
- Next
- piX.SetPalette caPalModeCustom, vPal()
- piX.Undo_AddPalette
- ViewImageData
- End Sub
- Private Sub mnEditCopy_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Copy
- End Sub
- Private Sub mnEditCut_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Cut
- End Sub
- Private Sub mnEditDrawMode0_Click(Index As Integer)
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- Dim n As Integer
- For n = 0 To mnEditEditMode0.ubound
- mnEditEditMode0(n).Checked = False
- Next
- For n = 1 To tlb0.Buttons.Count
- tlb0.Buttons(n).Value = tbrUnpressed
- Next
- tlb0.Buttons("draw").Value = tbrPressed
- piX.Mode = caModeDraw
- SetSelection "draw" & Index
- stb0.Panels(1).Text = "Mode: Draw"
- End Sub
- Private Sub mnEditEditMode0_Click(Index As Integer)
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- Dim n As Integer
- For n = 0 To mnEditDrawMode0.ubound
- mnEditDrawMode0(n).Checked = False
- Next
- For n = 0 To mnEditEditMode0.ubound
- mnEditEditMode0(n).Checked = False
- Next
- For n = 1 To tlb0.Buttons.Count
- tlb0.Buttons(n).Value = tbrUnpressed
- Next
- mnEditEditMode0(Index).Checked = True
- For n = 1 To tlb0.Buttons.Count
- If tlb0.Buttons(n).Key = mnEditEditMode0(Index).Tag Then
- tlb0.Buttons(n).Value = tbrPressed
- End If
- Next
- SetSelection mnEditEditMode0(Index).Tag
- stb0.Panels(1).Text = "Mode: Edit"
- End Sub
- Private Sub mnEditEffects_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- Dim lDepth As Long, f As New frmEffects
- lDepth = piX.ColorDepth
- f.Show 1
- If f.ChangePalette Then
- 'piX.SetPaletteFromImage ' Refreshs palette from soften and sharpen
- piX.SetImageFromPalette ' Refreshs palette from soften and sharpen
- End If
- ViewImageData
- End Sub
- Private Sub mnEditPaste_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Paste
- End Sub
- Private Sub mnFile24_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- ResetSliders
- piX.LoadPicture TestPath & "\TestB24.bmp"
- OpenDone
- End Sub
- Private Sub mnFile256_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- ResetSliders
- piX.LoadPicture TestPath & "\TestB256.bmp"
- OpenDone
- End Sub
- Private Sub mnColorCd24_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.ColorDepth = caRGB
- ViewImageData
- End Sub
- Private Sub mnColorCd8_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.ColorDepth = caPal256
- ViewImageData
- End Sub
- Private Sub mnColorCd4_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.ColorDepth = caPal16
- ViewImageData
- End Sub
- Private Sub mnColorCd1_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.ColorDepth = caPal2
- ViewImageData
- End Sub
- Private Sub mnImageFlip_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Mirror caMirrorVertical
- End Sub
- Private Sub mnFileGif_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- ResetSliders
- piX.LoadPicture TestPath & "\TestBG.gif"
- OpenDone
- End Sub
- Private Sub mnColorGray_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Undo_Add "gray scale"
- piX.GrayScale
- piX.Undo_AddPalette
- ViewImageData
- End Sub
- Private Sub mnFileJpg_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- ResetSliders
- piX.LoadPicture TestPath & "\TestBJ.jpg"
- OpenDone
- End Sub
- Private Sub mnImageMirror_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Mirror caMirrorHorizontal
- End Sub
- Private Sub mnFileOpen_Click()
- On Error GoTo EndS
- ResetSliders
- CD.CancelError = True
- CD.Filter = "All Pictures|*.bmp;*.jpg;*.gif;*.tif"
- CD.ShowOpen
- If Trim(CD.FileName) <> "" Then
- piX.LoadPicture CD.FileName
- OpenDone
- End If
- EndS:
- ' NOP
- End Sub
- Private Sub mnEditRedo_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Undo_Redo
- End Sub
- Private Sub mnImageRotate0_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Rotate 90
- End Sub
- Private Sub mnImageRotate1_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Rotate 270
- End Sub
- Private Sub mnImageRotate2_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Rotate 180
- End Sub
- Private Sub mnFileSave_Click()
- On Error GoTo EndS
- Dim f As New frmSave
- f.Show 1
- If Not f.Cancel Then
- CD.CancelError = True
- CD.Filter = "BMP File|*.bmp|GIF File|*.gif|JPG File|*.jpg|TIFF File|*.tif"
- If f.Extension = "bmp" Then CD.FilterIndex = 1
- If f.Extension = "gif" Then CD.FilterIndex = 2
- If f.Extension = "jpg" Then CD.FilterIndex = 3
- If f.Extension = "tif" Then CD.FilterIndex = 4
- CD.ShowSave
- If Trim(CD.FileName) <> "" Then
- If f.Extension = "bmp" Then
- piX.SavePicture Left(CD.FileName, InStr(1, CD.FileName, ".") - 1) & ".bmp", caFileBmp
- ElseIf f.Extension = "gif" Then
- piX.SavePicture Left(CD.FileName, InStr(1, CD.FileName, ".") - 1) & ".gif", caFileGif, , caGifTransparentWhite
- ElseIf f.Extension = "jpg" Then
- piX.SavePicture Left(CD.FileName, InStr(1, CD.FileName, ".") - 1) & ".jpg", caFileJpg, f.Compression
- ElseIf f.Extension = "tif" Then
- piX.SavePicture Left(CD.FileName, InStr(1, CD.FileName, ".") - 1) & ".tif", caFileTif
- End If
- End If
- End If
- EndS:
- ' NOP
- End Sub
- Private Sub mnEditUndo_Click()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Undo_Undo
- End Sub
- Private Sub piColor_Click(Index As Integer)
- On Error Resume Next
- CD.ShowColor
- If Err = 0 Then
- If Index = 0 Then
- piX.ForeColor = CD.Color
- piColor(Index).BackColor = piX.ForeColor
- ElseIf Index = 1 Then
- piX.EditColorRight = CD.Color
- piColor(Index).BackColor = piX.EditColorRight
- ElseIf Index = 2 Then
- piX.FillColor = CD.Color
- piColor(Index).BackColor = piX.FillColor
- End If
- End If
- End Sub
- Private Sub piX_CaptureColor(Color As stdole.OLE_COLOR)
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- If ButtonPressed = 1 Then piX.ForeColor = Color
- If ButtonPressed = 2 Then piX.EditColorRight = Color
- piColor(ButtonPressed - 1).BackColor = Color
- End Sub
- Private Sub piX_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- ButtonPressed = Button
- End Sub
- Private Sub tlb0_ButtonClick(ByVal Button As MSComctlLib.Button)
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- Select Case Button.Key
- Case "open": mnFileOpen_Click
- Case "save": mnFileSave_Click
- Case "undo": mnEditUndo_Click
- Case "redo": mnEditRedo_Click
- Case "draw": SelectModeButton Button.Key
- Case "select": SelectModeButton Button.Key
- Case "pen": SelectModeButton Button.Key
- Case "line": SelectModeButton Button.Key
- Case "rectangle": SelectModeButton Button.Key
- Case "ellipse": SelectModeButton Button.Key
- Case "fill": SelectModeButton Button.Key
- Case "erase": SelectModeButton Button.Key
- Case "capture": SelectModeButton Button.Key
- Case "palette": ViewImageData
- End Select
- End Sub
- Private Sub tmrUndo_Timer()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- Dim sUndo As String, sRedo As String
- Dim bUndo As Boolean, bRedo As Boolean
- piX.Undo_Query sUndo, bUndo, sRedo, bRedo
- If sUndo <> "" Then
- mnEditUndo.Caption = "Undo " & sUndo
- tlb0.Buttons("undo").ToolTipText = "Undo " & sUndo
- Else
- mnEditUndo.Caption = "Undo ..."
- tlb0.Buttons("undo").ToolTipText = "Undo ..."
- tlb0.Buttons("undo").Enabled = False
- End If
- mnEditUndo.Enabled = bUndo
- tlb0.Buttons("undo").Enabled = bUndo
- If sRedo <> "" Then
- mnEditRedo.Caption = "Redo " & sRedo
- tlb0.Buttons("redo").ToolTipText = "Redo " & sRedo
- Else
- mnEditRedo.Caption = "Redo ..."
- tlb0.Buttons("redo").ToolTipText = "Redo ..."
- tlb0.Buttons("redo").Enabled = False
- End If
- mnEditRedo.Enabled = bRedo
- tlb0.Buttons("redo").Enabled = bRedo
- End Sub
- Private Sub vscr0_Change()
- On Error GoTo SErr
- SErr: If ErrS Then Exit Sub
- piX.Top = ((pi0.ScaleHeight - piX.Height) / 2) - ((vscr0.Value - 4) * 1500)
- pi0.SetFocus
- End Sub
-